home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / tcl / tclm_1_0.lha / tclm-1.0 / mplay < prev    next >
Text File  |  1993-08-16  |  3KB  |  126 lines
  1. #!/usr/local/bin/tclm -f
  2. #
  3. # Copyright (c) 1993 Michael B. Durian.  All rights reserved.
  4. #
  5. # Redistribution and use in source and binary forms, with or without
  6. # modification, are permitted provided that the following conditions
  7. # are met:
  8. # 1. Redistributions of source code must retain the above copyright
  9. #    notice, this list of conditions and the following disclaimer.
  10. # 2. Redistributions in binary form must reproduce the above copyright
  11. #    notice, this list of conditions and the following disclaimer in the
  12. #    documentation and/or other materials provided with the distribution.
  13. # 3. All advertising materials mentioning features or use of this software
  14. #    must display the following acknowledgement:
  15. #    This product includes software developed by Michael B. Durian.
  16. # 4. The name of the the Author may be used to endorse or promote 
  17. #    products derived from this software without specific prior written 
  18. #    permission.
  19. #
  20. # THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED 
  21. # WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
  22. # OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.  
  23. # IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 
  24. # SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  25. # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
  26. # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  27. # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  28. # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
  29. # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
  30. # SUCH DAMAGE.
  31.  
  32. # mplay,v 1.7 1993/05/06 21:42:22 durian Exp
  33.  
  34. if {! [midiplayable]} {
  35.     puts stderr [concat "Cannot play.  Tclm was not compiled with the " \
  36.         "play functionality turned on."]
  37.     exit 1
  38. }
  39.  
  40. set repeat 0
  41. set tracks {}
  42. set speed 1.0
  43. set filenames {}
  44.  
  45. proc parse_arg {args} {
  46.     global repeat
  47.     global tracks
  48.     global speed
  49.     global filenames
  50.  
  51.     # strip away extra {}'s
  52.     set args [lindex $args 0]
  53.     set num_args [llength $args]
  54.     if {$num_args > 1 && [string compare [lindex $args 0] "-f"] == 0} {
  55.         set i 2
  56.     } else {
  57.         set i 0
  58.     }
  59.     for {} {$i < $num_args} {incr i} {
  60.  
  61.         set arg [lindex $args $i]
  62.         case $arg in \
  63.         -repeat {
  64.             set repeat 1
  65.         } -tracks {
  66.             set tracks [lindex $args [incr i]]
  67.         } -speed {
  68.             set speed [lindex $args [incr i]]
  69.         } default {
  70.             lappend filenames $arg
  71.         }
  72.     }
  73. }
  74.  
  75. parse_arg $argv
  76.  
  77. if {$repeat} {
  78.     set repeat repeat
  79. } else {
  80.     set repeat ""
  81. }
  82.  
  83. if {[llength $tracks] != 0} {
  84.     set tracks "tracks \"$tracks\""
  85. } else {
  86.     set tracks ""
  87. }
  88.  
  89. if {$speed != 1.0} {
  90.     set speed "reltempo $speed"
  91. } else {
  92.     set speed ""
  93. }
  94.  
  95. if {[llength $filenames] == 0} {
  96.     set midi_file stdin
  97.     set done 0
  98.     while {1} {
  99.         if {[catch {midiread $midi_file} mfile]} {
  100.             if {[string compare "$mfile" "EOF"] == 0} {
  101.                 exit 0
  102.             } else {
  103.                 puts stderr $mfile
  104.                 exit 1
  105.             }
  106.         }
  107.         eval "midiplay $repeat $tracks $speed $mfile"
  108.         midifree $mfile
  109.     }
  110. } else {
  111.     foreach file $filenames {
  112.         if {[catch {open $file} midi_file]} {
  113.             puts stderr $midi_file
  114.             exit 1
  115.         }
  116.         if {[catch {midiread $midi_file} mfile]} {
  117.             puts stderr $mfile
  118.             exit 1
  119.         }
  120.         eval "midiplay $repeat $tracks $speed $mfile"
  121.         midifree $mfile
  122.         close $midi_file
  123.     }
  124. }
  125. exit 0
  126.